﻿namespace MailChimp.Types

open System
open System.Text

//==================================================================================
//  Webhooks
//==================================================================================

module Webhooks =

    type WebhookType =
        | Subscribe = 0
        | Unsubscribe = 1
        | Profile = 2
        | UpEmail = 3
        | Cleaned = 4
        | Campaign = 5

    //------------------------------------------------------------------------------
    //  (*) CLI compatible event args
    //------------------------------------------------------------------------------

    type WebhooksEventArgs
        (typ: WebhookType, timestamp: DateTime, data: NestedDict, reqData: string) =
        inherit EventArgs()
        member x.Type = typ
        member x.Timestamp = timestamp
        member x.Data = data
        member x.RequestData = reqData

    type WebhooksEventHandler = delegate of obj * WebhooksEventArgs -> unit
    type ErrorEventHandler = delegate of obj * string -> unit


namespace MailChimp

open System
open System.IO
open System.Net
open System.Threading
open MailChimp.Types
open MailChimp.Types.Webhooks

//==================================================================================
//  Webhooks Listener
//==================================================================================

module WebhooksHelper =

    // Creates an async task to retrieve HttpListenerContext.
    // Checking if task has been canceled prevents exceptions
    // from being thrown when EndGetContext method is called.
    let createTask canceled (hl: HttpListener) =
        Async.FromBeginEnd(hl.BeginGetContext, fun ar ->
            if canceled() then None
            else Some (hl.EndGetContext(ar))) |> Async.Catch

    let checkKey key (req: HttpListenerRequest) =
        isNullOrEmpty key || req.QueryString.Get("key") = key

    let parseType (x: string) =
        try Enum.Parse(typeof<WebhookType>, x, true) :?> WebhookType |> Some
        with _ -> None

    let parseTime (x: string) =
        try DateTime.Parse(x) with _ -> DateTime()

    let parseData (req: HttpListenerRequest) =
        use sr = new StreamReader(req.InputStream, req.ContentEncoding)
        let data = sr.ReadToEnd()
        let qs = Web.HttpUtility.ParseQueryString(data)

        let typ = qs.Get("type") |> parseType
        let tm  = qs.Get("fired_at") |> parseTime

        match typ with
        | Some v ->
            let d = NestedDict.ParseQueryString(qs)
            Some <| WebhooksEventArgs(v, tm, d.GetDict("data"), data)
        | _ -> None

    // MailChimp validator UserAgent.
    [<Literal>]
    let uav = "mailchimp.com webhook validator"

    // Handles the received request.
    let handler key (x: Choice<HttpListenerContext opt, exn>) =
        match x with
        | Choice2Of2 ex -> Choice2Of3 ex.Message
        | Choice1Of2 cx ->
            match cx with
            | None -> Choice3Of3 ()
            | Some cx ->
                let req, resp = cx.Request, cx.Response
                let res =
                    if not (checkKey key req) then
                        resp.StatusCode <- 500; Choice2Of3 "Invalid secret key."
                    elif (req.UserAgent @? "").ToLower() = uav then
                        resp.StatusCode <- 200; Choice3Of3 ()
                    elif req.HttpMethod <> "POST" then
                        resp.StatusCode <- 500; Choice2Of3 "Invalid request method."
                    else
                        match (parseData req) with
                        | Some args -> resp.StatusCode <- 200; Choice1Of3 args
                        | _ -> resp.StatusCode <- 500; Choice2Of3 "Invalid data type."
                resp.OutputStream.Close(); res

open WebhooksHelper

[<Sealed>]
type WebhooksListener() =
    let mutable key = null
    let mutable cts = null
    let hl = new HttpListener()
    let ev = new Event<WebhooksEventHandler, WebhooksEventArgs>()
    let er = new Event<ErrorEventHandler, string>()

    member x.Key with get() = key and set(v) = key <- v
    member x.Prefixes = hl.Prefixes
    member x.IsListening = hl.IsListening

    member x.IgnoreWriteExceptions
        with get() = hl.IgnoreWriteExceptions
        and set(v) = hl.IgnoreWriteExceptions <- v

    member x.Start() =
        hl.Start()
        cts <- new CancellationTokenSource()
        let task = createTask (fun () -> cts.IsCancellationRequested) hl
        Async.Start(
            async {
                while true do
                    let! cx = task
                    Async.Start(
                        async {
                            match (handler key cx) with
                            | Choice1Of3 v -> ev.Trigger(x, v)
                            | Choice2Of3 v -> er.Trigger(x, v)
                            | _ -> ()
                        })
            }, cts.Token)

    member x.Stop()  = cts.Cancel(); hl.Stop()
    member x.Abort() = cts.Cancel(); hl.Abort()
    member x.Close() = cts.Cancel(); hl.Close()

    [<CLIEvent>]
    member x.WebhookReceived = ev.Publish
    [<CLIEvent>]
    member x.InvalidRequest = er.Publish

    interface IDisposable with
        member x.Dispose() = x.Abort()